home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / src / pt-exp.cc < prev    next >
C/C++ Source or Header  |  1997-03-07  |  15KB  |  918 lines
  1. /*
  2.  
  3. Copyright (C) 1996 John W. Eaton
  4.  
  5. This file is part of Octave.
  6.  
  7. Octave is free software; you can redistribute it and/or modify it
  8. under the terms of the GNU General Public License as published by the
  9. Free Software Foundation; either version 2, or (at your option) any
  10. later version.
  11.  
  12. Octave is distributed in the hope that it will be useful, but WITHOUT
  13. ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14. FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15. for more details.
  16.  
  17. You should have received a copy of the GNU General Public License
  18. along with Octave; see the file COPYING.  If not, write to the Free
  19. Software Foundation, 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  20.  
  21. */
  22.  
  23. #if defined (__GNUG__)
  24. #pragma implementation
  25. #endif
  26.  
  27. #ifdef HAVE_CONFIG_H
  28. #include <config.h>
  29. #endif
  30.  
  31. #include <iostream.h>
  32. #include <strstream.h>
  33.  
  34. #include "defun.h"
  35. #include "error.h"
  36. #include "gripes.h"
  37. #include "help.h"
  38. #include "input.h"
  39. #include "oct-obj.h"
  40. #include "pager.h"
  41. #include "ov.h"
  42. #include "pt-exp.h"
  43. #include "pt-fvc.h"
  44. #include "pt-misc.h"
  45. #include "pt-mvr.h"
  46. #include "pt-pr-code.h"
  47. #include "pt-walk.h"
  48. #include "utils.h"
  49.  
  50. // Nonzero means we're returning from a function.
  51. extern int returning;
  52.  
  53. // Nonzero means we're breaking out of a loop or function body.
  54. extern int breaking;
  55.  
  56. // Prefix expressions.
  57.  
  58. tree_prefix_expression::~tree_prefix_expression (void)
  59. {
  60.   delete id;
  61. }
  62.  
  63. octave_value
  64. tree_prefix_expression::eval (bool print)
  65. {
  66.   octave_value retval;
  67.  
  68.   if (error_state)
  69.     return retval;
  70.  
  71.   if (id)
  72.     {
  73.       switch (etype)
  74.     {
  75.     case increment:
  76.       id->increment ();
  77.       break;
  78.  
  79.     case decrement:
  80.       id->decrement ();
  81.       break;
  82.  
  83.     default:
  84.       error ("prefix operator %d not implemented", etype);
  85.       break;
  86.     }
  87.  
  88.  
  89.       if (error_state)
  90.     eval_error ();
  91.       else
  92.     {
  93.       retval = id->eval (print);
  94.       if (error_state)
  95.         {
  96.           retval = octave_value ();
  97.           if (error_state)
  98.         eval_error ();
  99.         }
  100.     }
  101.     }
  102.   return retval;
  103. }
  104.  
  105. char *
  106. tree_prefix_expression::oper (void) const
  107. {
  108.   static char *op;
  109.   switch (etype)
  110.     {
  111.     case increment:
  112.       op = "++";
  113.       break;
  114.  
  115.     case decrement:
  116.       op = "--";
  117.       break;
  118.  
  119.     default:
  120.       op = "<unknown>";
  121.       break;
  122.     }
  123.   return op;
  124. }
  125.  
  126. void
  127. tree_prefix_expression::eval_error (void)
  128. {
  129.   if (error_state > 0)
  130.     {
  131.       char *op = oper ();
  132.  
  133.       ::error ("evaluating prefix operator `%s' near line %d, column %d",
  134.            op, line (), column ());
  135.     }
  136. }
  137.  
  138. void
  139. tree_prefix_expression::accept (tree_walker& tw)
  140. {
  141.   tw.visit_prefix_expression (*this);
  142. }
  143.  
  144. // Postfix expressions.
  145.  
  146. tree_postfix_expression::~tree_postfix_expression (void)
  147. {
  148.   delete id;
  149. }
  150.  
  151. octave_value
  152. tree_postfix_expression::eval (bool print)
  153. {
  154.   octave_value retval;
  155.  
  156.   if (error_state)
  157.     return retval;
  158.  
  159.   if (id)
  160.     {
  161.       retval = id->eval (print);
  162.  
  163.       switch (etype)
  164.     {
  165.     case increment:
  166.       id->increment ();
  167.       break;
  168.  
  169.     case decrement:
  170.       id->decrement ();
  171.       break;
  172.  
  173.     default:
  174.       error ("postfix operator %d not implemented", etype);
  175.       break;
  176.     }
  177.  
  178.       if (error_state)
  179.     {
  180.       retval = octave_value ();
  181.       if (error_state)
  182.         eval_error ();
  183.     }
  184.     }
  185.   return retval;
  186. }
  187.  
  188. char *
  189. tree_postfix_expression::oper (void) const
  190. {
  191.   static char *op;
  192.   switch (etype)
  193.     {
  194.     case increment:
  195.       op = "++";
  196.       break;
  197.  
  198.     case decrement:
  199.       op = "--";
  200.       break;
  201.  
  202.     default:
  203.       op = "<unknown>";
  204.       break;
  205.     }
  206.   return op;
  207. }
  208.  
  209. void
  210. tree_postfix_expression::eval_error (void)
  211. {
  212.   if (error_state > 0)
  213.     {
  214.       char *op = oper ();
  215.  
  216.       ::error ("evaluating postfix operator `%s' near line %d, column %d",
  217.            op, line (), column ());
  218.     }
  219. }
  220.  
  221. void
  222. tree_postfix_expression::accept (tree_walker& tw)
  223. {
  224.   tw.visit_postfix_expression (*this);
  225. }
  226.  
  227. // Unary expressions.
  228.  
  229. octave_value
  230. tree_unary_expression::eval (bool /* print */)
  231. {
  232.   octave_value retval;
  233.  
  234.   if (error_state)
  235.     return retval;
  236.  
  237.   if (op)
  238.     {
  239.       octave_value u = op->eval (false);
  240.  
  241.       if (error_state)
  242.     eval_error ();
  243.       else if (u.is_defined ())
  244.     {
  245.       switch (etype)
  246.         {
  247.         case not:
  248.           retval = u.not ();
  249.           break;
  250.  
  251.         case uminus:
  252.           retval = u.uminus ();
  253.           break;
  254.  
  255.         case transpose:
  256.           retval = u.transpose ();
  257.           break;
  258.  
  259.         case hermitian:
  260.           retval = u.hermitian ();
  261.           break;
  262.  
  263.         default:
  264.           ::error ("unary operator %d not implemented", etype);
  265.           break;
  266.         }
  267.  
  268.       if (error_state)
  269.         {
  270.           retval = octave_value ();
  271.           eval_error ();
  272.         }
  273.     }
  274.     }
  275.  
  276.   return retval;
  277. }
  278.  
  279. char *
  280. tree_unary_expression::oper (void) const
  281. {
  282.   static char *op;
  283.   switch (etype)
  284.     {
  285.     case not:
  286.       op = "!";
  287.       break;
  288.  
  289.     case uminus:
  290.       op = "-";
  291.       break;
  292.  
  293.     case transpose:
  294.       op = ".'";
  295.       break;
  296.  
  297.     case hermitian:
  298.       op = "'";
  299.       break;
  300.  
  301.     default:
  302.       op = "<unknown>";
  303.       break;
  304.     }
  305.   return op;
  306. }
  307.  
  308. void
  309. tree_unary_expression::eval_error (void)
  310. {
  311.   if (error_state > 0)
  312.     {
  313.       char *op = oper ();
  314.  
  315.       ::error ("evaluating unary operator `%s' near line %d, column %d",
  316.            op, line (), column ());
  317.     }
  318. }
  319.  
  320. void
  321. tree_unary_expression::accept (tree_walker& tw)
  322. {
  323.   tw.visit_unary_expression (*this);
  324. }
  325.  
  326. // Binary expressions.
  327.  
  328. octave_value
  329. tree_binary_expression::eval (bool /* print */)
  330. {
  331.   octave_value retval;
  332.  
  333.   if (error_state)
  334.     return retval;
  335.  
  336.   if (op_lhs)
  337.     {
  338.       octave_value a = op_lhs->eval (false);
  339.  
  340.       if (error_state)
  341.     eval_error ();
  342.       else if (a.is_defined () && op_rhs)
  343.     {
  344.       octave_value b = op_rhs->eval (false);
  345.  
  346.       if (error_state)
  347.         eval_error ();
  348.       else if (b.is_defined ())
  349.         {
  350.           octave_value::binary_op op = octave_value::unknown_binary_op;
  351.  
  352.           switch (etype)
  353.         {
  354.         case add:
  355.           op = octave_value::add;
  356.           break;
  357.  
  358.         case subtract:
  359.           op = octave_value::sub;
  360.           break;
  361.  
  362.         case multiply:
  363.           op = octave_value::mul;
  364.           break;
  365.  
  366.         case el_mul:
  367.           op = octave_value::el_mul;
  368.           break;
  369.  
  370.         case divide:
  371.           op = octave_value::div;
  372.           break;
  373.  
  374.         case el_div:
  375.           op = octave_value::el_div;
  376.           break;
  377.  
  378.         case leftdiv:
  379.           op = octave_value::ldiv;
  380.           break;
  381.  
  382.         case el_leftdiv:
  383.           op = octave_value::el_ldiv;
  384.           break;
  385.  
  386.         case power:
  387.           op = octave_value::pow;
  388.           break;
  389.  
  390.         case elem_pow:
  391.           op = octave_value::el_pow;
  392.           break;
  393.  
  394.         case cmp_lt:
  395.           op = octave_value::lt;
  396.           break;
  397.  
  398.         case cmp_le:
  399.           op = octave_value::le;
  400.           break;
  401.  
  402.         case cmp_eq:
  403.           op = octave_value::eq;
  404.           break;
  405.  
  406.         case cmp_ge:
  407.           op = octave_value::ge;
  408.           break;
  409.  
  410.         case cmp_gt:
  411.           op = octave_value::gt;
  412.           break;
  413.  
  414.         case cmp_ne:
  415.           op = octave_value::ne;
  416.           break;
  417.  
  418.         case and:
  419.           op = octave_value::el_and;
  420.           break;
  421.  
  422.         case or:
  423.           op = octave_value::el_or;
  424.           break;
  425.  
  426.         default:
  427.           ::error ("binary operator %d not implemented", etype);
  428.           break;
  429.         }
  430.  
  431.           if (! error_state)
  432.         retval = ::do_binary_op (op, a, b);
  433.           else
  434.         {
  435.           retval = octave_value ();
  436.           eval_error ();
  437.         }
  438.         }
  439.       else
  440.         eval_error ();
  441.     }
  442.       else
  443.     eval_error ();
  444.     }
  445.   else
  446.     eval_error ();
  447.  
  448.   return retval;
  449. }
  450.  
  451. char *
  452. tree_binary_expression::oper (void) const
  453. {
  454.   static char *op;
  455.   switch (etype)
  456.     {
  457.     case add:
  458.       op = "+";
  459.       break;
  460.  
  461.     case subtract:
  462.       op = "-";
  463.       break;
  464.  
  465.     case multiply:
  466.       op = "*";
  467.       break;
  468.  
  469.     case el_mul:
  470.       op = ".*";
  471.       break;
  472.  
  473.     case divide:
  474.       op = "/";
  475.       break;
  476.  
  477.     case el_div:
  478.       op = "./";
  479.       break;
  480.  
  481.     case leftdiv:
  482.       op = "\\";
  483.       break;
  484.  
  485.     case el_leftdiv:
  486.       op = ".\\";
  487.       break;
  488.  
  489.     case power:
  490.       op = "^";
  491.       break;
  492.  
  493.     case elem_pow:
  494.       op = ".^";
  495.       break;
  496.  
  497.     case cmp_lt:
  498.       op = "<";
  499.       break;
  500.  
  501.     case cmp_le:
  502.       op = "<=";
  503.       break;
  504.  
  505.     case cmp_eq:
  506.       op = "==";
  507.       break;
  508.  
  509.     case cmp_ge:
  510.       op = ">=";
  511.       break;
  512.  
  513.     case cmp_gt:
  514.       op = ">";
  515.       break;
  516.  
  517.     case cmp_ne:
  518.       op = "!=";
  519.       break;
  520.  
  521.     case and:
  522.       op = "&";
  523.       break;
  524.  
  525.     case or:
  526.       op = "|";
  527.       break;
  528.  
  529.     default:
  530.       op = "<unknown>";
  531.       break;
  532.     }
  533.   return op;
  534. }
  535.  
  536. void
  537. tree_binary_expression::eval_error (void)
  538. {
  539.   if (error_state > 0)
  540.     {
  541.       char *op = oper ();
  542.  
  543.       ::error ("evaluating binary operator `%s' near line %d, column %d",
  544.            op, line (), column ());
  545.     }
  546. }
  547.  
  548. void
  549. tree_binary_expression::accept (tree_walker& tw)
  550. {
  551.   tw.visit_binary_expression (*this);
  552. }
  553.  
  554. // Boolean expressions.
  555.  
  556. octave_value
  557. tree_boolean_expression::eval (bool /* print */)
  558. {
  559.   octave_value retval;
  560.  
  561.   if (error_state)
  562.     return retval;
  563.  
  564.   bool result = false;
  565.  
  566.   if (op_lhs)
  567.     {
  568.       octave_value a = op_lhs->eval (false);
  569.  
  570.       if (error_state)
  571.     eval_error ();
  572.       else
  573.     {
  574.       bool a_true = a.is_true ();
  575.  
  576.       if (error_state)
  577.         eval_error ();
  578.       else
  579.         {
  580.           if (a_true)
  581.         {
  582.           if (etype == or)
  583.             {
  584.               result = true;
  585.               goto done;
  586.             }
  587.         }
  588.           else
  589.         {
  590.           if (etype == and)
  591.             goto done;
  592.         }
  593.  
  594.           if (op_rhs)
  595.         {
  596.           octave_value b = op_rhs->eval (false);
  597.  
  598.           if (error_state)
  599.             eval_error ();
  600.           else
  601.             {
  602.               result = b.is_true ();
  603.  
  604.               if (error_state)
  605.             eval_error ();
  606.             }
  607.         }
  608.           else
  609.         eval_error ();
  610.  
  611.         done:
  612.  
  613.           if (! error_state)
  614.         retval = octave_value ((double) result);
  615.         }
  616.     }
  617.     }
  618.   else
  619.     eval_error ();
  620.  
  621.   return retval;
  622. }
  623.  
  624. char *
  625. tree_boolean_expression::oper (void) const
  626. {
  627.   static char *op;
  628.   switch (etype)
  629.     {
  630.     case and:
  631.       op = "&&";
  632.       break;
  633.  
  634.     case or:
  635.       op = "||";
  636.       break;
  637.  
  638.     default:
  639.       op = "<unknown>";
  640.       break;
  641.     }
  642.   return op;
  643. }
  644.  
  645. // Simple assignment expressions.
  646.  
  647. tree_simple_assignment_expression::tree_simple_assignment_expression
  648.   (tree_identifier *i, tree_expression *r, bool plhs, bool ans_assign,
  649.    int l, int c)
  650.     : tree_expression (l, c)
  651.       {
  652.     init (plhs, ans_assign);
  653.     lhs = new tree_indirect_ref (i);
  654.     rhs = r;
  655.       }
  656.  
  657. tree_simple_assignment_expression::tree_simple_assignment_expression
  658.   (tree_index_expression *idx_expr, tree_expression *r, bool plhs,
  659.    bool ans_assign, int l, int c)
  660.     : tree_expression (l, c)
  661.       {
  662.     init (plhs, ans_assign);
  663.     lhs_idx_expr = idx_expr; // cache this -- we may need to delete it.
  664.     lhs = idx_expr->ident ();
  665.     index = idx_expr->arg_list ();
  666.     rhs = r;
  667.       }
  668.  
  669. tree_simple_assignment_expression::~tree_simple_assignment_expression (void)
  670. {
  671.   if (! preserve)
  672.     {
  673.       if (lhs_idx_expr)
  674.     delete lhs_idx_expr;
  675.       else
  676.     delete lhs;
  677.     }
  678.  
  679.   delete rhs;
  680. }
  681.  
  682. bool
  683. tree_simple_assignment_expression::left_hand_side_is_identifier_only (void)
  684. {
  685.   return lhs->is_identifier_only ();
  686. }
  687.  
  688. tree_identifier *
  689. tree_simple_assignment_expression::left_hand_side_id (void)
  690. {
  691.   return lhs->ident ();
  692. }
  693.  
  694. // ??? FIXME ??? -- should octave_variable_reference::assign return
  695. // the right thing for us to return?
  696.  
  697. octave_value
  698. tree_simple_assignment_expression::eval (bool print)
  699. {
  700.   assert (etype == tree_expression::assignment);
  701.  
  702.   octave_value retval;
  703.  
  704.   octave_value lhs_val;
  705.  
  706.   if (error_state)
  707.     return retval;
  708.  
  709.   if (rhs)
  710.     {
  711.       octave_value rhs_val = rhs->eval (false);
  712.  
  713.       if (error_state)
  714.     {
  715.       eval_error ();
  716.     }
  717.       else if (rhs_val.is_undefined ())
  718.     {
  719.       error ("value on right hand side of assignment is undefined");
  720.       eval_error ();
  721.     }
  722.       else
  723.     {
  724.       octave_variable_reference ult (lhs);
  725.  
  726.       if (error_state)
  727.         eval_error ();
  728.       else
  729.         {
  730.           if (index)
  731.         {
  732.           // Extract the arguments into a simple vector.
  733.  
  734.           octave_value_list args = index->convert_to_const_vector ();
  735.  
  736.           if (error_state)
  737.             eval_error ();
  738.           else
  739.             {
  740.               int nargin = args.length ();
  741.  
  742.               if (nargin > 0)
  743.             {
  744.               ult.assign (args, rhs_val);
  745.  
  746.               if (error_state)
  747.                 eval_error ();
  748.               else
  749.                 {
  750.                   lhs_val = ult.value ();
  751.  
  752.                   retval = rhs_val;
  753.                 }
  754.             }
  755.               else
  756.             error ("??? invalid index list ???");
  757.             }
  758.         }
  759.           else
  760.         {
  761.           ult.assign (rhs_val);
  762.  
  763.           lhs_val = ult.value ();
  764.  
  765.           retval = rhs_val;
  766.         }
  767.         }
  768.     }
  769.     }
  770.  
  771.   // Return value is RHS value, but the value we print is the complete
  772.   // LHS value so that expressions like x(2) = 2 (for x previously
  773.   // undefined) print b = [ 0; 2 ], which is more Matlab-like.
  774.  
  775.   if (! error_state && print && lhs_val.is_defined ())
  776.     lhs_val.print_with_name (lhs->name ());
  777.  
  778.   return retval;
  779. }
  780.  
  781. void
  782. tree_simple_assignment_expression::eval_error (void)
  783. {
  784.   if (error_state > 0)
  785.     {
  786.       int l = line ();
  787.       int c = column ();
  788.  
  789.       if (l != -1 && c != -1)
  790.     ::error ("evaluating assignment expression near line %d, column %d",
  791.          l, c);
  792.     }
  793. }
  794.  
  795. void
  796. tree_simple_assignment_expression::accept (tree_walker& tw)
  797. {
  798.   tw.visit_simple_assignment_expression (*this);
  799. }
  800.  
  801. // Colon expressions.
  802.  
  803. tree_colon_expression *
  804. tree_colon_expression::chain (tree_expression *t)
  805. {
  806.   tree_colon_expression *retval = 0;
  807.   if (! op_base || op_increment)
  808.     ::error ("invalid colon expression");
  809.   else
  810.     {
  811.       // Stupid syntax:
  812.       //
  813.       // base : limit
  814.       // base : increment : limit
  815.  
  816.       op_increment = op_limit;
  817.       op_limit = t;
  818.  
  819.       retval = this;
  820.     }
  821.   return retval;
  822. }
  823.  
  824. octave_value
  825. tree_colon_expression::eval (bool /* print */)
  826. {
  827.   octave_value retval;
  828.  
  829.   if (error_state || ! op_base || ! op_limit)
  830.     return retval;
  831.  
  832.   octave_value tmp = op_base->eval (false);
  833.  
  834.   if (tmp.is_undefined ())
  835.     {
  836.       eval_error ("invalid null value in colon expression");
  837.       return retval;
  838.     }
  839.  
  840.   double base = tmp.double_value ();
  841.  
  842.   if (error_state)
  843.     {
  844.       error ("colon expression elements must be scalars");
  845.       eval_error ("evaluating colon expression");
  846.       return retval;
  847.     }
  848.  
  849.   tmp = op_limit->eval (false);
  850.  
  851.   if (tmp.is_undefined ())
  852.     {
  853.       eval_error ("invalid null value in colon expression");
  854.       return retval;
  855.     }
  856.  
  857.   double limit = tmp.double_value ();
  858.  
  859.   if (error_state)
  860.     {
  861.       error ("colon expression elements must be scalars");
  862.       eval_error ("evaluating colon expression");
  863.       return retval;
  864.     }
  865.  
  866.   double inc = 1.0;
  867.  
  868.   if (op_increment)
  869.     {
  870.       tmp = op_increment->eval (false);
  871.  
  872.       if (tmp.is_undefined ())
  873.     {
  874.       eval_error ("invalid null value in colon expression");
  875.       return retval;
  876.     }
  877.  
  878.       inc = tmp.double_value ();
  879.  
  880.       if (error_state)
  881.     {
  882.       error ("colon expression elements must be scalars");
  883.       eval_error ("evaluating colon expression");
  884.       return retval;
  885.     }
  886.     }
  887.  
  888.   retval = octave_value (base, limit, inc);
  889.  
  890.   if (error_state)
  891.     {
  892.       if (error_state)
  893.     eval_error ("evaluating colon expression");
  894.       return octave_value ();
  895.     }
  896.  
  897.   return retval;
  898. }
  899.  
  900. void
  901. tree_colon_expression::eval_error (const char *s)
  902. {
  903.   if (error_state > 0)
  904.     ::error ("%s near line %d column %d", s, line (), column ());
  905. }
  906.  
  907. void
  908. tree_colon_expression::accept (tree_walker& tw)
  909. {
  910.   tw.visit_colon_expression (*this);
  911. }
  912.  
  913. /*
  914. ;;; Local Variables: ***
  915. ;;; mode: C++ ***
  916. ;;; End: ***
  917. */
  918.